home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / PREDEF5.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  28KB  |  1,093 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. /*    +---------------------------------------------------+
  10.       |                                                   |
  11.       |          I N T E R P     P R E D E F S            |
  12.       |         Part 5: TEXT_IO Scan Procedures           |
  13.       |                  (C Version)                      |
  14.       |                                                   |
  15.       |   Adapted From Low Level SETL version written by  |
  16.       |                                                   |
  17.       |                  Monte Zweben                     |
  18.       |               Philippe Kruchten                   |
  19.       |               Jean-Pierre Rosen                   |
  20.       |                                                   |
  21.       |    Original High Level SETL version written by    |
  22.       |                                                   |
  23.       |                   Clint Goss                      |
  24.       |               Tracey M. Siesser                   |
  25.       |               Bernard D. Banner                   |
  26.       |               Stephen C. Bryant                   |
  27.       |                  Gerry Fisher                     |
  28.       |                                                   |
  29.       |              C version written by                 |
  30.       |                                                   |
  31.       |               Robert B. K. Dewar                  |
  32.       |                                                   |
  33.       +---------------------------------------------------+
  34. */
  35.  
  36. /*  This module contains routines for the implementation of some of
  37.  *  the predefined Ada packages and routines, namely SEQUENTIAL_IO,
  38.  *  DIRECT_IO, TEXT_IO, and CALENDAR. Part 5 contains the scanning
  39.  *  procedures used for TEXT_IO input.
  40. */
  41.  
  42. #include <stdlib.h>
  43. #include <string.h>
  44. #include <ctype.h>
  45. #include "ipredef.h"
  46. #include "machinep.h"
  47. #include "predefp.h"
  48.  
  49. static char getcp();
  50. static char nextc();
  51. static void skipc();
  52. static void copyc();
  53. static void copy_integer();
  54. static void copy_based_integer();
  55. static void scan_blanks();
  56. static void setup_fixed_field(int);
  57. static void test_fixed_field_end();
  58. static int alpha(char);
  59. static int alphanum(char);
  60. static int graphic(char);
  61. static int digit(char);
  62. static int extended_digit(char);
  63. static int sign(char);
  64. static void check_digit();
  65. static void check_hash(char);
  66. static void check_extended_digit();
  67. static void range();
  68. static int scan_int();
  69. static int scan_based_int(int);
  70. static double scan_real_val(int);
  71. static void scan_enum_val();
  72. static int scan_integer_val(int *, int);
  73. static long scan_fixed_val(int *, int);
  74. static float scan_float_val(int *, int);
  75.  
  76. /* The following variables control whether we are scanning from a file or
  77.  * from a string. The flag scan_mode is 'F' if scanning from a file and 'S'
  78.  * if scanning from a string. The pointer ins points to the next character
  79.  * to be scanned in the case where we are scanning from a string.
  80.  */
  81.  
  82. static char scan_mode;
  83. static char *ins;
  84.  
  85. /* The variable s is used to store characters in work_string */
  86.  
  87. static char *s;
  88.  
  89.  
  90. /* GETCP */
  91.  
  92. /* This procedure gets the next character from the string or file being scanned
  93.  * according to the setting of scan_mode. In string mode, ins is updated. If no
  94.  * more character remain to be scanned, then END error is signalled.
  95.  */
  96.  
  97. static char getcp()                                                    /*;getcp*/
  98. {
  99.     if (scan_mode == 'F') {
  100.         return get_char();
  101.     }
  102.     else {
  103.         if (*ins == 0)
  104.             predef_raise(END_ERROR, "End of string encountered");
  105.         return * ins++;
  106.     }
  107. }
  108.  
  109.  
  110. /* NEXTC */
  111.  
  112. /* This procedure returns the next character to be read from the string or file
  113.  * being scanned, according to the setting of scan_mode. In string mode, ins is
  114.  * updated. If we are currently at end of string then a line feed is returned.
  115.  */
  116.  
  117. static char nextc()                                                    /*;nextc*/
  118. {
  119.  
  120.     if (scan_mode == 'F') {
  121.         load_look_ahead(FALSE);
  122.         return CHAR1;
  123.     }
  124.     else {
  125.         if (*ins) return *ins;
  126.         else return LINE_FEED;
  127.     }
  128. }
  129.  
  130.  
  131. /* SKIPC */
  132.  
  133. /* This procedure skips the next input character */
  134.  
  135. static void skipc()                                                  /*;skipc*/
  136. {
  137.     char c;
  138.  
  139.     if (scan_mode == 'F')
  140.         c = get_char();
  141.     else
  142.         ins++;
  143. }
  144.  
  145. /* COPYC */
  146.  
  147. /* This procedure copies the next input character to work_string using s */
  148.  
  149. static void copyc()                                                  /*;copyc*/
  150. {
  151.     char c;
  152.  
  153.     if (scan_mode == 'F')
  154.         c = get_char();
  155.     else
  156.         c = *ins++;
  157.     if (c)
  158.         *s++ = UPPER_CASE(c);
  159.     else
  160.         predef_raise (SYSTEM_ERROR, "End of string encountered");
  161. }
  162.  
  163. /* COPY_INTEGER */
  164.  
  165. /* This procedure copies a string with the syntax of "integer" from the
  166.  * input to the work string. Underscores are allowed but not copied.
  167.  */
  168.  
  169. static void copy_integer()                                      /*;copy_integer*/
  170. {
  171.     check_digit();
  172.  
  173.     while (digit(nextc())) {
  174.         copyc();
  175.         if (nextc() == '_') {
  176.             skipc();
  177.             check_digit();
  178.         }
  179.     }
  180. }
  181.  
  182.  
  183. /* COPY_BASED_INTEGER */
  184.  
  185. /* This procedure copies a string with the syntax of "based_integer" from
  186.  * the input to the work string. Underscores are allowed but not copied.
  187.  */
  188.  
  189. static void copy_based_integer()                      /*;copy_based_integer*/
  190. {
  191.     check_extended_digit();
  192.  
  193.     while (extended_digit(nextc())) {
  194.         copyc();
  195.         if (nextc() == '_') {
  196.             skipc();
  197.             check_extended_digit();
  198.         }
  199.     }
  200. }
  201.  
  202. /* SCAN_BLANKS */
  203.  
  204. /* Routine to scan past leading blanks to find first non-blank. Signals
  205.  * an exception if no non-blank character is located.
  206. */
  207.  
  208. static void scan_blanks()                                     /*;scan_blanks*/
  209. {
  210.     char c;
  211.  
  212.     if (scan_mode == 'F') {
  213.         for (;;) {
  214.             load_look_ahead(FALSE);
  215.             if (CHARS == 0)
  216.                 predef_raise(END_ERROR, "No item found");
  217.             c = nextc();
  218.             if (c == ' ' || c == HT || c == PAGE_MARK || c == LINE_FEED)
  219.                 getcp();
  220.             else break;
  221.         }
  222.         return;
  223.     }
  224.     else {
  225.         while(*ins == ' ' || *ins == HT) ins++;
  226.         return;
  227.     }
  228. }
  229.  
  230.  
  231. /* SETUP_FIXED_FIELD */
  232.  
  233. /* This procedure is used for numeric conversions where the field to be scanned
  234.  * has a fixed width(i.e. width parameter is non-zero). It acquires the field
  235.  * from the input file and copies it to work_string. It returns to the caller
  236.  * ready to scan the data from work_string.
  237.  */
  238.  
  239. static void setup_fixed_field(int width)                /*;setup_fixed_field*/
  240. {
  241.     char   *p;
  242.  
  243.     p = work_string;
  244.     for (;;) {
  245.         load_look_ahead(FALSE);
  246.         if (width-- != 0 && CHARS != 0 && CHAR1 != PAGE_MARK
  247.                                        && CHAR1 != LINE_FEED) {
  248.             *p++ = get_char();
  249.         }
  250.         else break;
  251.     }
  252.     *p = '\0';
  253.     scan_mode = 'S';
  254.     ins = work_string;
  255. }
  256.  
  257.  
  258. /* TEST_FIXED_FIELD_END */
  259.  
  260. /* This procedure is called after scanning an item from a fixed length field
  261.  * to ensure that only blanks remain in the field. An exception is raised if
  262.  * there are any unexpected non-blank characters left in the field.
  263. */
  264.  
  265. static void test_fixed_field_end()                    /*;test_fixed_field_end*/
  266. {
  267.     scan_blanks();
  268.     if (*ins)
  269.         predef_raise(data_exception,"Unexpected non-blank characters in field");
  270. }
  271.  
  272. /* ALPHA */
  273.  
  274. /* Procedure to test if character argument is an upper or lower case letter,
  275.  * returns TRUE if the argument is a letter, FALSE if it is not.
  276. */
  277.  
  278. static int alpha(char c)                                            /*;alpha*/
  279. {
  280.     if (c > 'Z')
  281.         c -= 32;
  282.     return ('A' <= c && c <= 'Z');
  283. }
  284.  
  285.  
  286. /* ALPHANUM */
  287.  
  288. /* Procedure to test if character argument is an upper or lower case letter,
  289.  * or a digit. Returns TRUE if the argument is a letter or digit, else FALSE.
  290. */
  291.  
  292. static int alphanum(char c)                             /*;alphanum*/
  293. {
  294.     if (c > 'Z')
  295.         c -= 32;
  296.     return (('A' <= c && c <= 'Z') ||('0' <= c && c <= '9'));
  297. }
  298.  
  299.  
  300. /* GRAPHIC */
  301.  
  302. /*  Procedure to test if character is an ASCII graphic character. Returns
  303.  *  Returns TRUE if the argument is an ASCII graphic, else FALSE.
  304. */
  305.  
  306. static int graphic(char c)                                          /*;graphic*/
  307. {
  308.     return (0x20 <= c && c <= 0x7f);
  309. }
  310.  
  311.  
  312. /* DIGIT */
  313.  
  314. /* Procedure to test if character is a digit, returns TRUE or FALSE */
  315.  
  316. static int digit(char c)                                /*;digit*/
  317. {
  318.     return ('0' <= c && c <= '9');
  319. }
  320.  
  321.  
  322. /* EXTENDED_DIGIT */
  323.  
  324. /* Procedu